home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
HyperCard Dev. ToolKit
/
Video.Drivers
/
Sony1500.p
< prev
Wrap
Text File
|
1987-08-17
|
7KB
|
284 lines
{$R-}
{$D+}
(*
Sony 1500 -- a HyperCard user-defined command to drive a laser disc
player. (Also Sony 1000A or Sony 2000)
©Apple Computer, Inc. 1987
All Rights Reserved.
To compile and link this file using Macintosh Programmer's Workshop
(HyperXCmd.p and XCmdGlue.inc must be accessible).
pascal -w Sony1500.p
link -m ENTRYPOINT -o HyperCommands -rt XCMD=16 -sn Main=Sony1500 ∂
Sony1500.p.o "{MPW}"Libraries:interface.o
then use ResEdit to copy the resulting XCMD from HyperCommands
and paste it into the Home stack, or your own stack.
(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000,
=15 PioneerLVP4200, =16 Sony1500)
*)
{$S Sony1500 } { Segment name must be the same as the command name. }
UNIT DummyUnit;
INTERFACE
USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
IMPLEMENTATION
TYPE Str19 = String[19];
Str31 = String[31];
PROCEDURE Sony1500(paramPtr: XCmdPtr); FORWARD;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
{ entry point cannot have local procs, but forward routines can }
BEGIN
Sony1500(paramPtr);
END;
PROCEDURE Sony1500(paramPtr: XCmdPtr);
VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
tempStr: Str255;
refNum: INTEGER;
err: INTEGER;
params: ARRAY[1..32] OF Str19;
{$I XCmdGlue.inc }
PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
BEGIN
paramPtr^.returnValue := PasToZero(errMsg);
EXIT(Sony1500);
END;
PROCEDURE OpenSerial;
VAR handShake: SerShk;
baudRate: INTEGER;
BEGIN
baudRate := 9600;
{ for now, use modem port so we don't mess with AppleTalk }
err := FSOpen('.AOUT',0,refNum);
IF err = 0 THEN
BEGIN
WITH handShake DO
BEGIN
fXon := 1;
fCTS := 1;
xon := CHR(17);
xoff := CHR(19);
errs := 0;
evts := 0;
fInx := 0;
END;
err := SerHShake(refNum,handShake);
IF err = 0 THEN
err := Control(refNum,13,@baudRate);
END;
END;
PROCEDURE CloseSerial;
BEGIN
err := FSClose(refNum);
END;
FUNCTION Concat(str1, str2, str3: Str31): Str31;
VAR result: Str255;
resultLen: INTEGER;
charNum: INTEGER;
BEGIN
result := '';
resultLen := 0;
FOR charNum := 1 TO Length(str1) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str1[charNum];
END;
FOR charNum := 1 TO Length(str2) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str2[charNum];
END;
FOR charNum := 1 TO Length(str3) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str3[charNum];
END;
result[0] := CHR(resultLen);
Concat := result;
END;
PROCEDURE SendCommand(myByte: INTEGER; cmd: Str31);
VAR count: LongInt;
temp: Str31;
{ all commands must have an extra char at end, which we smash with CR }
BEGIN
temp[1] := CHAR(myByte);
temp[0] := CHAR(1); {length}
IF length(cmd) > 0 THEN
BEGIN
temp := Concat(temp, cmd, '^');
temp[length(temp)] := CHAR($40); {enter, the completion char}
END;
count := Length(temp);
err := FSWrite(refNum, count, Pointer(Ord(@temp)+1));
END;
PROCEDURE GetMessage;
VAR paramNum, charNum: INTEGER;
msgChar: CHAR;
BEGIN
{ convert params to pascal strings }
FOR paramNum := 1 TO paramPtr^.paramCount DO
BEGIN
tempStr := params[paramNum];
ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
{ force all chars to lower case }
FOR charNum := 1 TO Length(tempStr) DO
BEGIN
msgChar := tempStr[charNum];
IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
END;
params[paramNum] := tempStr;
END;
END;
FUNCTION Contains(target: Str255): BOOLEAN;
VAR offset: INTEGER;
FUNCTION Match(which: INTEGER): BOOLEAN;
VAR index: INTEGER;
BEGIN
Match := TRUE;
FOR index := 1 TO Length(target) DO
IF index > Length(params[which]) THEN
BEGIN
Match := FALSE; { ran off the end }
EXIT(Match);
END
ELSE IF target[index] <> params[which][index] THEN
BEGIN
Match := FALSE; { hit a wrong char }
EXIT(Match);
END;
END;
BEGIN
Contains := FALSE;
FOR offset := 1 TO paramPtr^.paramCount DO
IF Match(offset) THEN
BEGIN
Contains := TRUE;
EXIT(Contains);
END;
END;
FUNCTION GetInteger: Str255;
{ get an integer as straight ASCII }
VAR which, digitLoc, charVal: INTEGER;
BEGIN
FOR which := 1 TO paramPtr^.paramCount DO
BEGIN
charVal := ORD(params[which][1]);
IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
BEGIN
GetInteger := params[which]; {that whole parameter}
exit(GetInteger);
END;
END;
GetInteger := ''; { just in case }
END;
BEGIN
OpenSerial;
IF err <> 0 THEN
BEGIN
SysBeep(1);
Fail('Could not open serial port');
END;
GetMessage;
{ set flags }
reverseFlag := Contains('rev');
offFlag := Contains('off');
tillFlag := Contains('till');
IF Contains('stop') THEN SendCommand($3F,'')
ELSE IF Contains('eject') THEN SendCommand($2A,'')
ELSE IF Contains('search') THEN SendCommand($43,GetInteger)
ELSE IF Contains('step') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand($2B,'') {step fwd}
ELSE SendCommand($2C,'') {step rev}
END
ELSE IF Contains('play') THEN
BEGIN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand($3A,'') {play fwd}
ELSE SendCommand($4A,''); {play rev}
END
ELSE SendCommand($44, Concat(GetInteger,'@','01')) {play till}
END
ELSE IF Contains('slow') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand($3C,'')
ELSE SendCommand($4C,'')
END
ELSE IF Contains('fast') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand($3B,'')
ELSE SendCommand($4B,'')
END
ELSE IF Contains('scan') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand($3E,'') {scan fwd}
ELSE SendCommand($4E,'') {scan rev}
END
ELSE IF Contains('picture') THEN
BEGIN
IF NOT offFlag THEN SendCommand($27,'') {picture on}
ELSE SendCommand($26,'') {picture off}
END
ELSE IF Contains('frame') THEN
BEGIN
IF NOT offFlag THEN SendCommand($50,'') {frame on}
ELSE SendCommand($51,'') {frame off}
END
ELSE IF Contains('sound') THEN
BEGIN
IF Contains('1') THEN
IF NOT offFlag THEN SendCommand($46,'') {sound 1 on}
ELSE SendCommand($47,'') {sound 1 off}
ELSE IF Contains('2') THEN
IF NOT offFlag THEN SendCommand($48,'') {sound 2 on}
ELSE SendCommand($49,'') {sound 2 off}
END
ELSE IF Contains('init') THEN SendCommand($62,'')
ELSE
BEGIN
CloseSerial;
SysBeep(1);
Fail('Unknown video command');
END;
CloseSerial;
END;
END.